#!/usr/bin/perl
# This is the frontend for the modules PIL::Parser and PIL::Nodes.
# See sub &usage at the bottom for usage information.

use warnings;
use strict;
use lib "lib";

# Minor hack
INIT {
  if($ENV{PIL2JS_RESOURCE_GUARD}) {
    require BSD::Resource;
    import BSD::Resource;
    setrlimit(RLIMIT_CPU(), 43, 47) or die "Couldn't setrlimit: $!\n";
    warn "*** Limited CPU resources.\n";
  }
}

use FindBin;
use File::Spec;
use lib File::Spec->catdir($FindBin::Bin, "lib");
use lib File::Spec->catdir($FindBin::Bin);
use PIL2JS qw< run_pugs >;
use Getopt::Long;
use PIL::Parser;
use PIL;
use Encode;

sub slurp;
sub unslurp;
sub usage;

my $verbose;
my $link;
my $output = "-";
my $yaml_dump;

GetOptions(
  "verbose"            => \$verbose,
  "link=s"             => \$link,
  "output=s"           => \$output,
  "yaml-dump"          => \$yaml_dump,
  "pugs=s"             => \$PIL2JS::cfg{pugs},
  "metamodel-base=s"   => \$PIL2JS::cfg{metamodel_base},
  "help"               => sub { usage() },
) or usage();
my @input = @ARGV;

usage "No input files given!"                  unless @input;
usage "Cannot compile multiple files at once!" if not $link and @input > 1;
usage "--yaml-dump doesn't work with --link!"  if $yaml_dump and $link;
usage "Invalid argument for --link!"           if $link and not($link eq "js" or $link eq "html");

unless($link) {
  warn "*** Reading input from \"$input[0]\"...\n" if $verbose;

  my $pil  = $input[0] =~ /\.(?:pl|p6|pm|p6m|t)$/i
    ? decode "utf-8", run_pugs("-CPIL1-Perl5", $input[0])
    : slurp $input[0];
  my $tree = PIL::Parser->parse($pil);

  if($yaml_dump) {
    require YAML;
    print encode "utf-8", YAML::Dump($tree);
    exit;
  }

  warn "*** Compiling PIL to JavaScript...\n" if $verbose;
  my $load_check = <<EOF;
try { PIL2JS.Box } catch(err) {
  var error = new Error("PIL2JS.js not loaded; aborting.");
  alert(error);
  throw(error);
}
EOF

  my $js = join "\n",
    $load_check,
    (bless $tree => "PIL")->as_js;
  unslurp $output, $js;
} else {
  my @components;
  # unshift @input, ($link eq "html" ? "~" : "") . guess_jsprelude_path();

  @input = map {
    /^(~?)METAMODEL$/
      ? map { $1 . $PIL2JS::cfg{metamodel_base} . join("/", split /\./, $_) . ".js" } qw<
          Perl6.MetaModel
          Perl6.Attribute
          Perl6.Method
          Perl6.MultiMethod
          Perl6.MetaClass.Dispatcher Perl6.MetaClass
          Perl6.Class Perl6.Instance
          Perl6.Object
        >
      : ($_)
  } @input;

  my $js;
  foreach my $file (@input) {
    my $mode = $file =~ s/^~// ? "link" : "inline";

    if($mode eq "inline") {
      warn "*** Reading JavaScript from \"$file\"...\n" if $verbose;
      push @components, [inline => "// File: $file\n" . slurp($file) . "\n"];
    } else {
      push @components, [link => $file];
    }
  }

  push @components, [inline => <<EOF];
// Trigger running of all END blocks.
PIL2JS.catch_all_exceptions(function () {
  PIL2JS.catch_end_exception(function() {
    PIL2JS.runloop(function () {
      _26main_3a_3aexit.FETCH()([
        PIL2JS.Context.ItemAny,
        new PIL2JS.Box.Constant(undefined),
        function () { 'dummycc' }
      ]);
    });
  });
});
EOF

  if($link eq "js") {
    my $js;
    foreach (@components) {
      my ($mode, $contents) = @$_;
      die "*** Can't link to files when creating a standalone JavaScript file!\n"
        if $mode eq "link";
      $js .= $contents;
    }

    unslurp $output, $js;
  } else {
    my $indent = sub { join "\n", map { " " x 6 . $_ } split "\n", shift };
    my $link   = sub { "<script type=\"text/javascript\" src=\"$_[0]\"></script>" };

    my $html = <<EOF;
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
  "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
  <head>
    <title>PIL2JS</title>
  </head>

  <body>
    <pre id="__pil2js_tty"></pre>

EOF

    foreach (@components) {
      my ($mode, $contents) = @$_;
      if($mode eq "link") {
        $html .= "    " . $link->($contents) . "\n";
      } else {
        die "JavaScript contains HTML escape sequenze ']]>', aborting.\n"
          if $contents =~ /\]\]>/;
        $html .= <<EOF;
    <script type="text/javascript">//<![CDATA[
@{[$indent->($contents)]}
      //]]>
    </script>
EOF
      }
    }

    $html .= <<EOF;
  </body>
</html>
EOF
    unslurp $output, $html;
  }
}

sub usage {
  if($_[0]) {
    die "*** $_[0]\n    Try \"$0 --help\" for usage information.\n";
  } else {
    print STDERR <<USAGE; exit }}
pil2js.pl compiles PIL as generated by Pugs to JavaScript.

Usage: pil2js.pl [options] -- input_files

Available options (options may be abbreviated to uniqueness):
  --verbose         Be verbose.

  --pugs=/path/to/pugs
  --metamodel-base=/path/to/Perl6.MetaModel/lib/

  --output=...      Output to the given filename.
                    Use "-" if you want the result to go to STDOUT.
  --link=html|js    Link precompiled files into one standalone JavaScript
                    file ("js") or into a HTML file ("html").

  --yaml-dump       Only output the input PIL as YAML; don't compile anything.

When compiling (--link option not given), there has to be only one input file.
In linking mode, multiple input files may be specified. If a filename is
prefixed with a tilde ("~"), the file is not inlined, but instead linked to
using the HTML tag "<script src=...>". Of course, this feature is not available
when linking to a standalone JavaScript file.

Recommended usage:
  \$ cd perl5/PIL2JS
  \$ ./pil2js.pl -o Prelude.js lib6/Prelude/JS.pm
  \$ ./pil2js.pl -o test.js test.pl
  \$ ./pil2js.pl -o test.js test.pil
  \$ ./pil2js.pl --link=js   -o full.js    METAMODEL  libjs/PIL2JS.js  Prelude.js test.js
  \$ ./pil2js.pl --link=html -o test.html ~METAMODEL ~libjs/PIL2JS.js ~Prelude.js test.js
USAGE

sub slurp {
  open my $fh, "< $_[0]" or die "Couldn't open \"$_[0]\" for reading: $!\n";
  local $/;
  return decode "utf-8", <$fh>;
}

sub unslurp {
  open my $fh, "> $_[0]"          or die "Couldn't open \"$_[0]\" for writing: $!\n";
  print $fh encode "utf-8", $_[1] or die "Couldn't write to \"$_[0]\": $!\n";
  close $fh                       or die "Couldn't close \"$_[0]\": $!\n";
}
